home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / NJ93.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  2.4 KB  |  87 lines  |  [TEXT/R*ch]
  1. (* NJ93.sml 1995-02-24 
  2.    Half-way compatibility with those SML/NJ 0.93 basis structures
  3.    which were open in the initial environment. *)
  4.  
  5. fun print s = 
  6.     let open BasicIO 
  7.     in output(std_out, s); flush_out std_out end
  8.  
  9. (* NJ93 Integer *)
  10.  
  11. fun max (x, y) = if x > y then x else y : int;
  12. fun min (x, y) = if x > y then y else x : int;
  13.  
  14. (* NJ93 List *)
  15.  
  16. exception Hd and Tl and Nth and NthTail
  17.  
  18. fun hd arg      = (List.hd arg) handle Empty => raise Hd;
  19. fun tl arg      = (List.tl arg) handle Empty => raise Tl;
  20. fun nthtail arg = (List.drop arg) handle Subscript => raise NthTail;
  21. fun nth arg     = (List.nth arg) handle Subscript => raise Nth;
  22.  
  23. fun app f xs =
  24.     let fun h []      = ()
  25.       | h (x::xr) = (f x; h xr)
  26.     in h xs end;
  27. fun revapp f xs =
  28.     let fun h []      = ()
  29.       | h (x::xr) = (h xr; f x; ())
  30.     in h xs end;
  31.  
  32. fun fold f xs e    = List.foldr f e xs;
  33. fun revfold f xs e = List.foldl f e xs;
  34.  
  35. (* NJ93 Real *)
  36.  
  37. fun ceiling r  = ~(floor (~r));
  38. fun truncate r = if r >= 0.0 then floor r else ceiling r;
  39.  
  40. (* NJ93 Ref *)
  41.  
  42. fun inc r = r := !r+1;
  43. fun dec r = r := !r-1;
  44.  
  45. (* NJ93 String *)
  46.  
  47. prim_val chr : int    -> string = 1 "sml_chr";
  48. prim_val ord : string -> int    = 1 "sml_ord";
  49.  
  50. local 
  51.     prim_val create_string_ : int -> string                = 1 "create_string";
  52.     prim_val nth_char_      : string -> int -> int         = 2 "get_nth_char";
  53.     prim_val set_nth_char_  : string -> int -> int -> unit = 3 "set_nth_char";
  54.     prim_val blit_string_   : string -> int -> string -> int -> int -> unit 
  55.                                                            = 5 "blit_string";
  56. in 
  57.     exception Substring;
  58.     fun ordof(s, i) = 
  59.     if i < 0 orelse i >= size s then raise Ord
  60.     else nth_char_ s i;
  61.     fun substring (s, i, n) = (String.substring (s, i, n)) 
  62.                           handle Subscript => raise Substring;
  63.     fun explode s =
  64.     let fun loop 0 acc = acc
  65.           | loop n acc =
  66.         let val n' = n - 1
  67.             val x = create_string_ 1
  68.         in
  69.             set_nth_char_ x 0 (nth_char_ s n');
  70.             loop n' (x::acc)
  71.         end
  72.     in loop (size s) [] end;
  73.  
  74.     fun implode ss =
  75.     let fun resultSizeAcc [] acc = acc
  76.           | resultSizeAcc (s::ss) acc = resultSizeAcc ss (acc + size s)
  77.         val rlen = resultSizeAcc ss 0
  78.         val r = create_string_ rlen
  79.         fun loop [] i = ()
  80.           | loop (s::ss) i =
  81.         let val slen = size s in
  82.             blit_string_ s 0 r i slen;
  83.             loop ss (i + slen)
  84.         end
  85.     in loop ss 0; r end;
  86. end;
  87.